00100	C***** SUBRS RHYTH, SETUP,MARKS  ********
00200	
00300		SUBROUTINE RHYTH
00400		DIMENSION R(10,80)
00500		COMMON/DPY/ST(4000),WDS(250),MEDIT,GO /XRN/RN(4000)
00600		COMMON/SCM/V(78),I,LCNT,STAFF,LIST(200),REND
00700		COMMON /SCX/RHY(4),JALPHA(20),JX,JXX,JZ,IRHY,JD,KA,KB,IZ
00800		COMMON /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JA,DBST,
00900		1 NFLG,IXX,IQT,VX(50),IAMP,K,KN,M,MODE,IBLA /FLM/RPOS(2,300)
01000		COMMON/ALF/INP(59),NX,NOTE,JSET,KZ,KX,AVGPOS,RLPOS,RLP2,
01100		1 AVP2,ZX,RE,ZZ,RD,RSTX
01200	C   SEE ALSO FILLMS, SETLET AND SETUP  RE. /FLM/
01300		COMMON /POS/POS1,POS2 /STF/RSTFAC(-3/4),RSTJ3
01400	CC	EQUIVALENCE (RPOS(1,1),RN(3921)),(VX(1),X),(VX(2),Y),(VX(7)
01500		EQUIVALENCE (VX(1),X),(VX(2),Y),(VX(7)
01600		1,Z),(VX(3),AB),(VX(4),T),(VX(5),RB),(VX(6),X2)
01700		1,(VX(8),C),(VX(9),S),(VX(10),X3),(SET4,RN(3920)),(RA,RN(3919))
01800		1,(R,RN(3001)),(STUP,RN(3921)),(PS2,RN(3922))
01900	
02000		RSTJ3=RSTFAC(IFIX(STAFF))
02200		NX=-1
02300		JX=0
02400		NOTE=0
02500		Y=0
02600		JSET=0
02700	C  NEG. IF SETUP IS NOT READY
02900		IF(STUP)GO TO 341
03000		KZ=1
03100		POS2=PS2
03200	C  GETS LAST ↑↑ POS. FROM SETUP
03300		JSET=-1
03400	C  NEXT NUM.(100) IS LIMIT FOR STF.4 (CAN BE UP TO 300-SEE /FLM/)
03500		DO 9 KX=1,100
03600	9	IF(RPOS(2,KX).GT.0)GO TO 10
03700	10	AVGPOS=RPOS(1,KX)
03800		RLPOS=AVGPOS
03900		KX=KX+1
04000		RLP2=RPOS(1,KX)
04100	343	AVP2=RPOS(2,KX)-.001
04200		IF(AVP2.GT.0)GO TO 341
04300		KX=KX+1
04400		GO TO 343
04500	C  AVERAGED AND REAL POSITIONS FROM 'SETUP'
04600	
04700	C  NEXT FOR NON-SETUP
04800	341	DO 34 K=1,IRHY
04900	34	IF(V(K).GT..05)Y=ABS(V(K))+Y
05000	C  88TH NOTES ARE TAKEN AS GRACE NOTES.
05100	C  Y=TOTAL TIME
05200		IF(JSET)GO TO 3421
05300	
05400		IF(POS1.LT.POS2)POSX=POS1
05500	C  SAVES IT FOR BACKUP
05600		IF(POS1.GE.POS2)POS1=POSX
05700	
05800		Z=POS2-POS1
05900		ZX=Z
06000	342	DO 1 K=1,IZ
06100		X=R(1,K)
06200		IF(X.LT.3.)GO TO 1
06300	C  JUMP IF NOTE OR REST
06400		IF(X.NE.7.)GO TO 8
06500	C   JUMP IF NOT A KEY SIG.
06600		RA=2.+ABS(R(4,K))*2.0
06700		GO TO 6
06800	8	IF(X.NE.4.)GO TO 81
06900	C   NEXT IS FOR BAR LINES
07000		RA=3
07050		J=K+1
07100		RE=R(1,J)
07200		IF(RE.EQ.3.)RA=1.5
07300	C  A CLEF
07400		IF(RE.EQ.18)RA=2.5
07500	C  A METER
07600		IF(RE.EQ.1.AND.AMOD(R(5,J),10.).NE.0)RA=4.5
07700	C  FINDS ACCI ON NEXT NOTE.
07800	83	IF(K.EQ.IZ)RA=0
07900	C  END OF STAFF
08000		GO TO 6
08100	82	RA=6
08200		GO TO 83
08300	81	IF(X.EQ.18)GO TO 82
08400		RA=7.
08500	C   FOR CLEFS
08600		IF(K.LT.3)RA=9.
08700	C   THE FIRST CLEF IS NOT MINI
08800	6	RA=RA*RSTJ3
08900	C  SO SPACE WILL DEPEND ON SIZE OF STAFF
09000		Z=Z-RA
09100		R(8,K)=RA
09200	C   STORES SPACE NUM THAT MUST BE GIVEN BACK
09300	1	CONTINUE
09400	C   SUBTRACTS SPACE FOR CLEF OR BAR.  WILL ADD BOTH LATER.
09500	C  POS1 AND Z ARE FOR RHYTHMIC SPACING
09700	C  SPACE FOR NON-NOTES
09800	134	FORMAT(' **** MISMATCH WITH STF.4 ****')
09900	3421	K=0
10000		IF(ABS(Y-RA).GT..001.AND.JSET)TYPE 134
10100	
10200	C   LOOP TO END
10300	3	K=K+1
10400	C   K IS COUNTER
10600		R(7,K)=0
10700		RE=R(1,K)
10800		IF(RE.LE.2.)GO TO 2
10900		RD=R(8,K)
11000		R(8,K)=0
11100		IF(JSET)GO TO 71
11200	
11300	7	IF(K.EQ.IZ)POS1=POS2
11400		IF(R(1,K-1).GT.2..OR.K.EQ.1.OR.RE.EQ.4.)GO TO 73
11500		Z=Z+RD/3.
11600	C   RETURNS 1/3 OF THE SPACE IF PREV. ITEM IS NOTE OR REST
11700		POS1=POS1-RD/3
11800	C  THIS CAN RESULT IN OVERLAP WHICH MUST BE EDITED OUT.!!
11900	73	R(2,K)=POS1
12000	72	POS1=POS1+RD
12100	C   ABOVE SECTION LEAVES ROOM FOR CLEF OR BAR
12200		GO TO 337
12300	
12400	C  40???   50????  WHY NOT 100?
12600	71	DO 74 J=KZ,80
12700	74	IF(RE.EQ.-RPOS(2,J))GO TO 75
12800		POS=R(2,K-1)+4
12900		GO TO 76
13000	75	POS=RPOS(1,J)
13100		KZ=J+1
13200	C  FOUND SAME TYPE OF ITEM.
13300	76	R(2,K)=POS
13400		GO TO 337
13500	
13600	2	JX=JX+1
13700	21	AB=V(JX)
13800		IF(RE.EQ.2)V(JX)=-AB
13900	C  SHOWS RESTS IN AUTO. BEAM SECTION.(ASSUMES REST WAS A + NUMB.)
13910		J=9
13920		IF(RE.EQ.2)J=7
14000		IF(R(8,K).GE.0)R(J,K)=AB
14100	C  STORES RHYTH VALUE FOR LATER USE IN PART EXTRACTOR IF NOT CHORD NOTE.
14200		IF(AB.GT..05)GO TO 210
14300		R(2,K)=-1.
14400		RA=100
14500		AB=R(4,K)
14600		IF(AB)RA=-RA
14700		R(4,K)=AB+RA
14800		R(8,K)=1000
14900	C  1000 IN P8 PUTS IN SLASH ON TAIL
15000	C  FOUND A GRACE NOTE  (88TH NOTE)
15050		R(7,K)=1
15100		GO TO 337
15200	210	RB=0
15300	CC	IF(JSET.GE.0.AND.SET4.LT.0)R(8,K)=-AB-1000.*R(8,K)
15400	C  FOR AUTOMATIC SETUP
15500		JZ=K
15600	C  JZ WILL BE USED NEAR END
15700	CC3634	IF(AMOD(AB,.1875).EQ.0)GO TO 122
15710	3634	IF(AMOD(AB,.1875).EQ.0.OR.AMOD(AB*10.,1.5).EQ.0)GO TO 122
15800	C  .1875 FINDS SINGLE DOTS ON NOTES (.15 FOR QUINTS) (*10 FOR ROUNDOFF!)
15900		IF(AMOD(AB,.4375).NE.0)GO TO 22
16000	CC	T=2
16050		T=20
16100		GO TO 322
16200	CC122	T=1
16250	122	T=10
16300	322	IF(RE.EQ.2.)GO TO 35
16400	CC	R(7,K)=R(7,K)+10.*T
16450		R(7,K)=T
16500	C  PUTS ONE OR TWO DOTS
16600	C  DOTS THE NOTE.
16700		GO TO 36
16800	
16900	35	R(6,K)=T
17000	C  ADDS DOT TO REST.
17100	36	RB=AB/3.
17200		IF(T.NE.1)RB=(4*AB)/7
17300	C  TO KEEP TAIL ON DOTTED NOTE
17400	
17500	22	POS=POS1
17600		IF(JSET.EQ.0)GO TO 220
17700	
17800	C  NEXT IS FOR SETUP
17900	222	IF(NOTE)GO TO 223
18000	C  FIRST TIME A NOTE IS FOUND.
18100		NOTE=-1
18200		POS1=RLPOS
18300		Z=POS2-POS1
18400	C  RESETS SPACE AVAILABLE, ZZ IS SPACE FOR NON-NOTES
18500	223	IF(POS1.LT.AVP2)GO TO 221
18600	224	KX=KX+1
18700	C???? OCT, 73	 	IF(NX.EQ.0)GO TO 225
19000		IF(NX)RLP2=RPOS(1,KX)
19100		NX=-1
19200	225	IF(RPOS(2,KX-1))GO TO 227
19300		RLPOS=RPOS(1,KX-1)
19400		AVGPOS=AVP2
19500	227	AVP2=RPOS(2,KX)-.001
19600		IF(AVP2.GT.0)GO TO 223
19700	C  0 IN RPOS=POS. OF NON-NOTE
19800	CC****** WHY NEEDED?? 6/74 ***	IF(RLP2.GE.POS1)NX=0
19900		NX=0
20000	CC*****↑↑↑↑ CHANGED FROM ABOVE ***  6/74
20100		GO TO 224
20200	221	POS=(POS1-AVGPOS)*(RLP2-RLPOS)/(AVP2-AVGPOS)+RLPOS
20400	220	R(2,K)=POS
20600	4634	IF((AB.GE.2.OR.AB.EQ.1.333333333).AND.RE.EQ.1
20700		1)GO TO 4
20900	44	L=K+1
21000		IF(R(8,L).GE.0.OR.R(1,L).NE.1.)GO TO 1634
21100	C   JUMP IF NOT DOUBLE STOP
21200	CC	IF(AB.GE.4)R(5,K)=AMOD(R(5,K),10.0)
21300	C  DELETES STEM FROM WHOLE NOTE CHORD (NOW DONE IN NOTWRT IF P7=1)
21400		R(2,L)=R(2,K)
21500		K=L
21700		R(8,K)=0
21800		GO TO 3634
21900	C  LOOPS BACK TO PICK UP MORE CHORD NOTES
22000	
22100	C 'WHITENS' HALF, WHOLE AND TRIPLET HALF NOTES.
22200	4	RA=-R(6,K)
22300		IF(RA.EQ.0)RA=-1
22400		IF(AB.LT.4.)GO TO 144
22500		R(7,K)=R(7,K)+1
22600	C  +1=WHOLE NOTE WILL PRINT 
22700		RA=-2.
22800	144	R(6,K)=RA
22900		GO TO 44
23000	
23100	1634	T=POS1
23200		POS1=AB/Y*Z+POS1
23300		GO TO 1636
23400		IF(JSET)GO TO 1636
23500		RP=6.
23600		IF(AMOD(R(5,K+1),10.0).EQ.0)RP=3.
23700	C  3 SPACES IF NO ACCID. ON NEXT NOTE, OTHERWISE 6.
23800		RA=POS1-T
23900		RSTX=RP*RSTJ3
24000		IF(RA.GT.RSTX)GO TO 1636
24100	C  JUMP IF NOTES ARE FAR ENOUGH APART
24200		RA=RSTX-RA
24300	C  THE DIFFERENCE
24400		Z=Z-Z*RA/(POS2-POS1)
24500	C  REDUCES TOTAL SIZE Z 
24600		POS1=T+RSTX
24700	1636	T=0
24800		RA=AB-RB
24810		IF(RA.EQ.4./6..OR.RA.EQ.4./7..OR.RA.GT..75)GO TO 535
24820	C  KEEPS TAILS OFF TRIPLETS, QUINTS, SEPTS.
24900		DO 534 N=1,4
25000	534	IF(RA.LE.RHY(N))T=N
25100	CC535	IF(AB.GE.4.)R(5,K)=AMOD(R(5,K),10.0)
25300	C  DELETES STEM FROM WHOLE NOTES. (NOW DONE IN NOTWRT IF P7=1)
25400	535	IF(R(1,JZ).EQ.1.)GO TO 334
25500		R(4,JZ)=0
25600	C  SETS REST
25700		IF(AB.GE.2)T=-1
25800		IF(AB.GE.4)T=-2
25900	C  WON'T DO DOUBLE DOTTED WHOLE NOTES.
26000		R(5,JZ)=T
26100		GO TO 337
26200	C*******  4/74  NEW WAY TO FIND TAILS
26300	C  OMITS RESTS  (REALLY???)
26400	334	R(7,JZ)=T+R(7,JZ)
26500	337	IF(K.LT.IZ)GO TO 3
26600		DO 335 K=IZ,1,-1
26700		IF(R(2,K).GE.0)GO TO 335
26800		IF(K.NE.IZ)GO TO 336
26900		R(2,K)=POS2-4.
27000		GO TO 335
27100	336	R(2,K)=R(2,K+1)-4.
27200	335	CONTINUE
27300		K=0
27400	45	K=K+1
27500	C  NEXT IS TO ARRANGE DOTS.
27600		IF(R(7,K).LT.10)GO TO 451
27700		RA=R(2,K)
27800		DO 452 M=K+1,IZ
27900		IF(R(2,M).NE.RA)GO TO 453
28000	C  JUMP IF NOT CHORD NOTE.
28100		IF(ABS(R(6,M)).LT.30.)GO TO 452
28200	C  JUMP IF NOTE IS NOT ON LEFT SIDE OF UPWARD STEM
28300		IF(R(4,M)-R(4,M-1).NE.2)GO TO 452
28400		IF(AMOD(R(4,M),2.).NE.0)R(7,M)=AMOD(R(7,M),10.)
28500	C  TAKES AWAY DOT IN CERTAIN CASES TO AVOID CONFUSION.
28600	452	CONTINUE
28700	453	K=M-1
28800	451	IF(K.LT.IZ)GO TO 45
28900	
28910		N=IZ
29000		IF(JSET.OR.SET4.GE.0)GO TO 13
29100		M=IZ
29200		RA=-1
29300		DO 23 K=1,IZ
29400		M=M+1
29500		IF(R(2,K).NE.RA.AND.ABS(R(4,K)).LT.100)GO TO 123
29600		M=M-1
29700		GO TO 23
29800	123	RA=R(2,K)
29900	C  TO CATCH DBL STOPS AND MINI-NOTES
30000		DO 323 L=1,9
30100	323	R(L,M)=R(L,K)
30200		R(3,M)=4
30300	CC	AB=R(8,K)
30400	CC	R(8,M)=AMOD(AB,1000.)
30500	CC	R(8,K)=IFIX(AB/-1000.)
30600	23	CONTINUE
30700		IZ=M
30800	C ABOVE SETS UP STAFF 4 IF IT WASN'T ALREADY
30900	13	IF(IREAD)RETURN
31000		DIMENSION ISU(320)
31100		COMMON R2,JH,CENTR,J2,R3,R4,R5,RJQ(17),J3,JQ(19)
31200		1  /POSI/STFF(-3/4),JJ2,POSQ /FRMT/FQZ(3),IREAD
31300		EQUIVALENCE (JF,JQ(3)),(ISU(1),ST(3600))
31400		CALL DPYSET(3,ISU,320)
31500		CALL DPYBRT(6)
31550		J3=STAFF
31575		POSQ=STFF(J3)
31600		JF=1
31700		RA=-100
31800		R4=20
31900	C  R5=0=1  STANDARD SIZE IS USED.
32000		DO 131 K=1,N
32100		IF(R(1,K).NE.1.OR.R(2,K).EQ.RA)GO TO 131
32150		RA=R(2,K)
32200		R2=RHORZ(RA)
32300		CALL PNUM
32400	C  GOES TO DRAW A NUMBER OVER A NOTE
32500		JF=JF+1
32600		IF(JF.EQ.10)JF=0
32700	131	CONTINUE
32800	132	CALL DPYOUT(3)
32900		CALL SETPOG(1)
33000		END
33100	
33200	C  SETUP ALLOWS YOU TO SET UP RHYTHMS ON STAFF 4 FOR SPACING ALL OTHERS.
33300		SUBROUTINE SETUP
33400	      COMMON/FLM/RPOS(2,300) /ALF/JX,X,RD,RNL,RN6,M,A,RB,RC,
33500		1 INP(64) /SCM/V(78),IV,LCNT,STAFF,LIST(200),REND
33600		COMMON /PTR/PWDS(250),ITEM,L,I,IX
33700		COMMON/DPY/ST(4000),WDS(250),MEDIT,GO /XRN/RN(4000)
33800		EQUIVALENCE (RA,RN(3919)),(ENDP,RN(3922)),(SETFLG,RN(3921))
34000	
34100	C  RHYTHMIC VALUES ARE SAVED AS NEG. NUMS. IN P8 OF NOTES AND RESTS, ETC.
34300		SETFLG=-1
34400	C  THIS SENDS INFO TO SUBR. NOTES
34500		IF(STAFF.EQ.4)RETURN
34600		JX=0
34650	CC	RNL=0
34700		RA=0
34800		DO 9534 K=1,ITEM
34900		L=PWDS(K)
35000	      IF(RN(L+3).NE.4.)GO TO 9534
35100		RD=RN(L+1)
35200		IF(RD.LT.5.OR.RD.EQ.7.OR.RD.EQ.18)GO TO 5
35300	CC	IF(RD.NE.9)GO TO 9534
35350		GO TO 9534
35400	CC	TYPE 6
35500	CC	RETURN
35600	CC6	FORMAT(' ***** NO BEAMS FOR RHY SETUP')
35700	5	JX=JX+1
35800		RPOS(1,JX)=RN(L+2)
35900		IF(RD.GT.2)GO TO 3
36000	CC	RNL=RN(L)
36100	CC7	IF(RNL.GE.6.AND.RN(L+8))GO TO 177
36200	C JUMP WHEN TIME VALUES ARE IN P8
36300	CC	RN6=RN(L+6)
36400		IF(RD.EQ.1)M=9
36410		IF(RD.EQ.2)M=7
36441		RC=RN(L+M)
36473	C  FOR VALUES AUTOMATICALLY SET. ALLOWS NON-DUPLE UNITS IN SETUP
36600	CC	AA=RN(L+5)
36700	CC	A=RN6
36800	CC	IF(RNL.LT.3)AA=0
36900	CC	IF(RNL.LT.4)A=0
37000	CC	GO TO 332 	
37100	C   GETS VALUE OF DOTTED RESTS.  *** USE AS SUBR. ??? ****
37200	C PICKS UP TIME VALUE IN P5 AND P6
37300	CC31	RB=RN(L+7)
37400	CC	IF(RN6.LT.0)GO TO 231
37600	CC	AA=AMOD(RB,10.)
37700	CC	GO TO 331
37800	CC231	AA=RN6
37900	C331	A=IFIX(RB/10)
38000	CC332	CALL DOTS(L,AA,A,RC)
38200	277	RA=RA+RC
38300	C  SUM OF RHYTHS
38400		GO TO 77
38800	3	RC=-RD
38900	77	RPOS(2,JX)=RC
39000	C  RC IS RHYTHMIC VALUE OF NOTE.
39100	9534	CONTINUE
39200	C  NEXT PUTS ITEMS IN PROPER ORDER IF THEY WEREN'T ALREADY
39300	CC	IF(JX.EQ.0.OR.RNL.EQ.0)RETURN
39325		IF(JX.EQ.0)RETURN
39350	C  JX=0 OR RNL=0 MEANS DIDN'T FIND RHYTHMS ON STAFF 4
39400	
39500		CALL SORT2(RPOS,JX)
39600		ENDP=200.
39700		IF(RPOS(2,JX))ENDP=RPOS(1,JX)
39800		DO 1 L=1,JX
39900	1	IF(RPOS(2,L).GT.0)GO TO 4
40000	4	RD=RPOS(1,L)
40100		RB=ENDP-RD
40200	C  TOTAL SPACE FROM 1ST NOTE TO END OF LINE
40300		RC=RPOS(2,L)
40400		RPOS(2,L)=RD
40500	C REAL AND AVERAGED POSITIONS OF 1ST NOTE ARE THE SAME.
40600		DO 2 K=L+1,JX
40700		RE=RPOS(2,K)
40800		IF(RE)GO TO 2
40900		RD=RC/RA*RB+RD
41000		RC=RE
41100		RPOS(2,K)=RD
41200	2	CONTINUE
41300	C  1,K=REAL POS.    2,K=AVERAGED POS.
41400	C   IN RHYTH:  POS=(P1-AVG2)*(RL2-RL1)/(AVG2-AVG1)+RL1
41500		JX=JX+1
41600		RPOS(1,JX)=ENDP
41700		RPOS(2,JX)=ENDP
41800		SETFLG=0
41900	C  THIS FOR NOTES AND RHYTH
42000		END
42100	
42200		SUBROUTINE MARKS(RA)
42300		COMMON/ALF/INP(72),ML
42400		DIMENSION MKS(11)
42500		DATA MKS/'W','A','F','S','M','T','D','U','H','I','P'/
42600		EQUIVALENCE (M3,MKS(3)),(M9,MKS(9))
42700		RA=99
42800		DO 16 JM=1,72
42900	16	IF(INP(JM))GO TO 17
43000	C  DIDN'T FIND  MORE LETTERS
43100		RETURN
43200	17	N=INP(JM)
43300		ML=INP(JM+1)
43400		M=INP(JM+2)
43500		DO 1 K=1,11
43600	1	IF(N.EQ.MKS(K))GO TO 2
43700	C  DID NOT FIND A LETTER
43800		RETURN
43850	C 4-(EDGE),5-A(CCENT),26-F(ERMATA),7-S(TACCATO),M(?),9-T(ENUTO),11-D(OWNBOW),
43875	C 12-U(PBOW),13-H(ARMONIC),14-P(LUS),15-TH(ESIS),16-AR(SIS),17-MO(RDANT),
43881	C 18-I(NVRTD MORD), ---,20-TR(ILL)
43900	2	GO TO(12,10,12,12,4,11,15,15,15,21,12),K
44000	15	K=K+1
44100	12	K=K+3
44200	8	RA=K
44300	C  YOU CAN TYPE # OR NAME OF MARK
44400		DO 6 JM=1,72
44500		N=INP(JM)
44600		INP(JM)=' '
44700	C  BLANKS OUT USED LETTERS
44800	6	IF(N.EQ.'/'.OR.N.EQ.'*'.OR.N.EQ.';')RETURN
44850	4	IF(ML.EQ.'O')GO TO 20
44900		K=21
45000		IF(ML.NE.M3)GO TO 8
45100	18	K=K+1
45200		GO TO 8
45300	5	K=14
45400		GO TO 8
45500	10	IF(ML.NE.'R')GO TO 12
45550	19	K=13
45600	C  'R' FOR ARSIS
45700		GO TO 12
45800	11	IF(ML.EQ.M9)K=12
45900	C THESIS
45950		IF(ML.EQ.'R')K=17
46000		GO TO 12
46010	20	K=17
46020		GO TO 8
46030	21	K=18
46040		GO TO 8
46100		END
46200	
46300		SUBROUTINE DOTS(L,Z,X,RC)
46400	C  M=BASIC RHY.  NX=NUM OF DOTS
46500		COMMON /XRN/RN(4000)
46600		RC=4./2.**(Z+2.)
46700		IF(RN(L).LT.4.OR.X.EQ.0)RETURN
46800	C -2=WHOLE, -1=HALF, 0=QUART, 1=EIGHTH, 2=SIXTEENTH, ETC.
46900		B=RC
47000		DO 100 NN=1,IFIX(X)
47100		B=B/2
47200	100	RC=RC+B
47300		END